module fiona_buffer_mod

#ifdef HAS_MPI
  use mpi
#endif

  implicit none

  type buffer_type
    integer :: size = 0
    integer :: is, ie
    integer(2), allocatable :: i2(:)
    integer(4), allocatable :: i4(:)
    real(4), allocatable :: r4(:)
    real(8), allocatable :: r8(:)
  contains
    procedure :: init => buffer_init
    procedure :: attach => buffer_attach
    procedure :: detach => buffer_detach
    procedure :: shift_index_back => buffer_shift_index_back
    procedure :: shift_index => buffer_shift_index
    procedure :: clear => buffer_clear
    final :: buffer_final
  end type buffer_type

contains

  subroutine buffer_init(this, size, elem)

    class(buffer_type), intent(inout) :: this
    integer, intent(in) :: size
    class(*), intent(in) :: elem

    select type (elem)
    type is (integer(2))
      allocate(this%i2(size))
    type is (integer(4))
      allocate(this%i4(size))
    type is (real(4))
      allocate(this%r4(size))
    type is (real(8))
      allocate(this%r8(size))
    end select
    this%is = 0

  end subroutine buffer_init

  subroutine buffer_attach(this)

    class(buffer_type), intent(in) :: this
    
    integer ierr

#ifdef HAS_MPI
    if (allocated(this%i2)) then
      call MPI_BUFFER_ATTACH(this%i2, size(this%i2), ierr)
    else if (allocated(this%i4)) then
      call MPI_BUFFER_ATTACH(this%i4, size(this%i4), ierr)
    else if (allocated(this%r4)) then
      call MPI_BUFFER_ATTACH(this%r4, size(this%r4), ierr)
    else if (allocated(this%r8)) then
      call MPI_BUFFER_ATTACH(this%r8, size(this%r8), ierr)
    end if
#endif

  end subroutine buffer_attach

  subroutine buffer_detach(this)

    class(buffer_type), intent(in) :: this

    integer n, ierr

#ifdef HAS_MPI
    if (allocated(this%i2)) then
      call MPI_BUFFER_DETACH(this%i2, n, ierr)
    else if (allocated(this%i4)) then
      call MPI_BUFFER_DETACH(this%i4, n, ierr)
    else if (allocated(this%r4)) then
      call MPI_BUFFER_DETACH(this%r4, n, ierr)
    else if (allocated(this%r8)) then
      call MPI_BUFFER_DETACH(this%r8, n, ierr)
    end if
#endif

  end subroutine buffer_detach

  subroutine buffer_shift_index_back(this)

    class(buffer_type), intent(inout) :: this

    this%is = 0

  end subroutine buffer_shift_index_back

  subroutine buffer_shift_index(this, size)

    class(buffer_type), intent(inout) :: this
    integer, intent(in) :: size

    if (this%is == 0) then
      this%is = 1
      this%ie = size
    else
      this%is = this%ie + 1
      this%ie = this%ie + size
    end if

  end subroutine buffer_shift_index

  subroutine buffer_clear(this)

    class(buffer_type), intent(inout) :: this

    if (allocated(this%i2)) deallocate(this%i2)
    if (allocated(this%i4)) deallocate(this%i4)
    if (allocated(this%r4)) deallocate(this%r4)
    if (allocated(this%r8)) deallocate(this%r8)
    this%is = 0

  end subroutine buffer_clear

  subroutine buffer_final(this)

    type(buffer_type), intent(inout) :: this

    call this%clear()

  end subroutine buffer_final

end module fiona_buffer_mod
